Datos

En este ejemplos consideramos la red de aeropuertos de EU:

library(tidyverse)
library(tidygraph)
library(ggraph)
library(igraphdata)
data("USairports")
# ver detalles
# ?USairports

Nota que cada arista corresponde a una aerolínea (carrier) y tipo de avión (Aircraft), y los nodos son los aeropuertos. Los datos de las aristas corresponden a vuelos de Diciembre de 2010, y es una gráfica dirigida.

Sobre los datos:

Vertex attributes Description
name Symbolic vertex name, this is the three letter IATA airport code.
City City and state, where the airport is located.
Position Position of the airport, in WGS coordinates.
Edge attributes Description
Carrier Name of the airline. The network includes both domestic and international carriers that performed at least one flight in December of 2010.
Departures The number of departures (for a given airline and aircraft type.
Seats The total number of seats available on the flights carried out by a given airline, using a given aircraft type.
Passengers The total number of passangers on the flights carried out by a given airline, using a given aircraft type.
Aircraft Type of the aircraft.
Distance The distance between the two airports, in miles.
airports <- USairports %>% as_tbl_graph()
airports
# A tbl_graph: 755 nodes and 23473 edges
#
# A directed multigraph with 6 components
#
# Node Data: 755 x 3 (active)
  name  City          Position        
  <chr> <chr>         <chr>           
1 BGR   Bangor, ME    N444827 W0684941
2 BOS   Boston, MA    N422152 W0710019
3 ANC   Anchorage, AK N611028 W1495947
4 JFK   New York, NY  N403823 W0734644
5 LAS   Las Vegas, NV N360449 W1150908
6 MIA   Miami, FL     N254736 W0801726
# … with 749 more rows
#
# Edge Data: 23,473 x 8
   from    to Carrier  Departures Seats Passengers Aircraft Distance
  <int> <int> <chr>         <dbl> <dbl>      <dbl>    <int>    <dbl>
1     1     4 British…          1   226        193      627      382
2     1     4 British…          1   299        253      819      382
3     2     7 British…          1   216        141      627      200
# … with 2.347e+04 more rows

En total son 755 aeropuertos y 23,473 tipos aerolíneas y tipos de aviones.

Esta gŕafica es un multigrafo (puede haber varias aristas con la misma dirección en un par de nodos).

Nos interesa en primer lugar agregar a un grafo, y considerar el total de pasajeros (puedes también considerar número de asientos, por ejemplo) que viajó entre cada par de aeropuertos. Podemos agregar de las siguiente forma:

# seleccionamos solo pasajeros
vertices <- airports %>% 
  activate(edges) %>% 
  select(to, from, Passengers) %>% as_tibble()
# agregar
vertices_agregados <- vertices %>% 
  group_by(to, from) %>% 
  summarise(pax = sum(Passengers))
# nodos, y agregar estado
nodos <- airports %>% activate(nodes) %>% 
  as_tibble() %>% 
  separate(City, into = c('ciudad_nombre', 'estado'), sep = ', ')
# construir nueva red
aeropuertos <- tbl_graph(nodes = nodos, edges = vertices_agregados) 
aeropuertos 
# A tbl_graph: 755 nodes and 8265 edges
#
# A directed multigraph with 6 components
#
# Node Data: 755 x 4 (active)
  name  ciudad_nombre estado Position        
  <chr> <chr>         <chr>  <chr>           
1 BGR   Bangor        ME     N444827 W0684941
2 BOS   Boston        MA     N422152 W0710019
3 ANC   Anchorage     AK     N611028 W1495947
4 JFK   New York      NY     N403823 W0734644
5 LAS   Las Vegas     NV     N360449 W1150908
6 MIA   Miami         FL     N254736 W0801726
# … with 749 more rows
#
# Edge Data: 8,265 x 3
   from    to   pax
  <int> <int> <dbl>
1     2     1     2
2     4     1    35
3     6     1     3
# … with 8,262 more rows
# seleccionamos solo asientos
vertices <- airports %>% 
  activate(edges) %>% 
  select(to, from, Seats) %>% as_tibble()
# agregar
vertices_agregados <- vertices %>% 
  group_by(to, from) %>% 
  summarise(pax = sum(Seats))
# nodos, y agregar estado
nodos <- airports %>% activate(nodes) %>% 
  as_tibble() %>% 
  separate(City, into = c('ciudad_nombre', 'estado'), sep = ', ')
# construir nueva red
aeropuertos <- tbl_graph(nodes = nodos, edges = vertices_agregados) 
aeropuertos 
# A tbl_graph: 755 nodes and 8265 edges
#
# A directed multigraph with 6 components
#
# Node Data: 755 x 4 (active)
  name  ciudad_nombre estado Position        
  <chr> <chr>         <chr>  <chr>           
1 BGR   Bangor        ME     N444827 W0684941
2 BOS   Boston        MA     N422152 W0710019
3 ANC   Anchorage     AK     N611028 W1495947
4 JFK   New York      NY     N403823 W0734644
5 LAS   Las Vegas     NV     N360449 W1150908
6 MIA   Miami         FL     N254736 W0801726
# … with 749 more rows
#
# Edge Data: 8,265 x 3
   from    to   pax
  <int> <int> <dbl>
1     2     1    34
2     4     1    50
3     6     1    12
# … with 8,262 more rows

Filtro de conexiones débiles

Podemos también filtrar opcionalmente aquellas conexiones que tengan un número de pasajeros bajo durante el mes de observación. La distribución de pasajeros podemos examinarla con:

pasajeros <- aeropuertos %>% activate(edges) %>% 
  select(from, to , pax)
quantile(pull(pasajeros, pax), seq(0, 1, 0.1))
      0%      10%      20%      30%      40%      50%      60% 
     1.0     13.0     50.0    142.0    862.2   1856.0   3343.4 
     70%      80%      90%     100% 
  5273.8   8948.2  18117.2 142839.0 
corte_pax <- 100
aero_grandes <- aeropuertos %>% activate(edges) %>% 
  filter(pax > corte_pax) %>% 
  activate(nodes) %>% 
  filter(!node_is_isolated()) #eliminar nodos que quedan sin conexiones

Haz una primera gráfica (checa también como colorear según una variable de nodos):

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros")) %>% 
    ggraph(layout = 'fr', niter = 2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_ca)) +
    theme_graph()

Pregunta 1: cuántas componentes tiene esta gráfica (tip: haz un mutate con la función group_components)

Esta gráfica cuenta con 8 componentes.

aero_grandes %>%
  activate(nodes) %>%
  mutate(group = group_components())
# A tbl_graph: 575 nodes and 6174 edges
#
# A directed multigraph with 8 components
#
# Node Data: 575 x 5 (active)
  name  ciudad_nombre estado Position         group
  <chr> <chr>         <chr>  <chr>            <int>
1 BGR   Bangor        ME     N444827 W0684941     1
2 BOS   Boston        MA     N422152 W0710019     1
3 ANC   Anchorage     AK     N611028 W1495947     1
4 JFK   New York      NY     N403823 W0734644     1
5 LAS   Las Vegas     NV     N360449 W1150908     1
6 MIA   Miami         FL     N254736 W0801726     1
# … with 569 more rows
#
# Edge Data: 6,174 x 3
   from    to   pax
  <int> <int> <dbl>
1    41     1   122
2    42     1  2176
3    55     1  3935
# … with 6,171 more rows
aero_grandes
# A tbl_graph: 575 nodes and 6174 edges
#
# A directed multigraph with 8 components
#
# Node Data: 575 x 4 (active)
  name  ciudad_nombre estado Position        
  <chr> <chr>         <chr>  <chr>           
1 BGR   Bangor        ME     N444827 W0684941
2 BOS   Boston        MA     N422152 W0710019
3 ANC   Anchorage     AK     N611028 W1495947
4 JFK   New York      NY     N403823 W0734644
5 LAS   Las Vegas     NV     N360449 W1150908
6 MIA   Miami         FL     N254736 W0801726
# … with 569 more rows
#
# Edge Data: 6,174 x 3
   from    to   pax
  <int> <int> <dbl>
1    41     1   122
2    42     1  2176
3    55     1  3935
# … with 6,171 more rows

Return value of group_component: a numeric vector with the membership for each node in the graph. The enumeration happens in order based on group size progressing from the largest to the smallest group

Pregunta 2: prueba otro layout: kk o graphopt, por ejemplo. ¿Puedes reconocer estructuras distintas? ¿Qué método parece funcionar mejor?

aero_grandes %>% 
    activate(nodes) %>% 
    #mutate(color_ca = ifelse(estado == "LA", "LA", "Otros")) %>% 
    ggraph(layout = 'kk') + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour =estado)) +
    theme_graph()

aero_grandes %>% 
    activate(nodes) %>% 
    mutate(color_ca = ifelse(estado == "CA", "CA", "Otros")) %>% 
    ggraph(layout = 'graphopt') + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(colour = color_ca)) +
    theme_graph()

Extraer componente grande

Filtra la componente conexa más grande:

aero <- aero_grandes %>% 
    activate(nodes) %>% 
    mutate(component = group_components()) %>%
    filter(component == 1)

Intermediación

Calcula intermediación:

aero <- aero %>% activate(nodes) %>% 
  mutate(intermediacion = centrality_betweenness())
aero
# A tbl_graph: 558 nodes and 6151 edges
#
# A directed multigraph with 1 component
#
# Node Data: 558 x 6 (active)
  name  ciudad_nombre estado Position         component intermediacion
  <chr> <chr>         <chr>  <chr>                <int>          <dbl>
1 BGR   Bangor        ME     N444827 W0684941         1           35.0
2 BOS   Boston        MA     N422152 W0710019         1        14605. 
3 ANC   Anchorage     AK     N611028 W1495947         1        86686. 
4 JFK   New York      NY     N403823 W0734644         1         9464. 
5 LAS   Las Vegas     NV     N360449 W1150908         1        13065. 
6 MIA   Miami         FL     N254736 W0801726         1         2847. 
# … with 552 more rows
#
# Edge Data: 6,151 x 3
   from    to   pax
  <int> <int> <dbl>
1    41     1   122
2    42     1  2176
3    55     1  3935
# … with 6,148 more rows

Pregunta 3: ¿cuáles son los aeropuertos con intermediación más grande? (convierte el objeto de la gráfica a tibble después de activar nodos).

Ciudad Estado Intermediación
Anchorage AK-Alaska 86686
Denver CO-Colorado 35444
Minneapolis MN- Minnesota 33674
Bethel AK-Alaska 31412
Seattle WA-Washington 30286

Ahora haz una gráfica coloreando con un estado relevante (considera tu respuesta de la pregunta anterior) y usando la intermediación como tamaño:

aero %>%
    activate(nodes) %>% 
    mutate(color_edo = ifelse(estado == "AK", "AK", "Otros")) %>% 
    ggraph(layout = 'fr', niter=2000) + 
    geom_edge_link(arrow = arrow(length = unit(2, 'mm')), alpha = 0.1, colour="gray") + 
    geom_node_point(aes(size = intermediacion, colour=color_edo)) +
    theme_graph()

Pregunta 4 Explica el nodo con mayor intermediación de la gráfica. ¿Qué conecta?

Conecta Alaska con el resto de los Estados.

Centralidad de eigenvector

Calcula centralidad de eigenvector, y ahora usa tamaño para esta centralidad y color para intermediación

aero<- aero %>%
    activate(nodes) %>% 
    mutate(central_eigen = centrality_eigen())
aero %>%
    activate(nodes) %>% 
    mutate(central_eigen = centrality_eigen()) %>%
    as_tibble() %>%
    arrange(desc(central_eigen))%>%
    head()

Pregunta 5 ¿Cuáles son los aeropuertos con mayor centralidad de eigenvector? Contrasta con intermediación.

ciudad_nombre estado intermediacion central_eigen
Atlanta GA-Georgia 26290.09 1.0000000
Chicago IL-Illinois 29361.47 0.9840030
Dallas/Ft.Worth TX-Texas 20743.55 0.9230075
Denver CO-Colorado 35444.43 0.9131323
Minneapolis MN-Minnesota 33673.76 0.9082336
Detroit MI-Michigan 17181.70 0.8987680

Examinar centralidad

Elimina los aeropuertos de Alaska y vuelve a graficar, esta vez usando centralidad de eigenvector para color y tamaño.

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% 
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) + 
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  theme_graph() 

Pregunta 6: ¿calcular centralidad y luego filtrar nodos es lo mismo que filtrar nodos y luego calcular centralidad?

No. Falta desarrollar por qué.

Pregunta 7: experimenta con los parámetros del layout (por ejemplo, los 2 que se usan arriba). ¿Cómo obtienes mejores resultados?

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% 
ggraph(layout = 'graphopt', spring.constant = 0.95, charge = 0.05, niter = 300) + 
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  theme_graph() 

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% 
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.95, niter = 300) + 
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  theme_graph() 

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% 
ggraph(layout = 'graphopt', spring.constant = 0.5, charge = 0.5, niter = 300) + 
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  theme_graph() 

Pregunta 8 (más difícil): etiqueta los nodos. Etiqueta solo los nodos que tengan centralidad de eigenvector alta. Puedes experimentar (layout, colores, tamaño de texto) con este código:

aero %>%
  activate(nodes) %>% 
  filter(estado!="AK") %>% 
ggraph(layout = 'graphopt', spring.constant = 0.25, charge = 0.05, niter = 300) + 
  geom_edge_link2(arrow = arrow(length = unit(2, 'mm')), alpha = 0.01, colour="black") + 
  geom_node_point(aes(size = central_eigen, colour=central_eigen)) +
  geom_node_text(aes(label = name, alpha = central_eigen>0.8987679), repel = TRUE, size = 3, color = "black") +
  theme_graph() 

LS0tCnRpdGxlOiAiQ2VudHJhbGlkYWQgZW4gcmVkZXMiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCgojIyMgRGF0b3MKCkVuIGVzdGUgZWplbXBsb3MgY29uc2lkZXJhbW9zIGxhIHJlZCBkZSBhZXJvcHVlcnRvcyBkZSBFVToKCmBgYHtyLCBtZXNzYWdlID0gRkFMU0V9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KHRpZHlncmFwaCkKbGlicmFyeShnZ3JhcGgpCmxpYnJhcnkoaWdyYXBoZGF0YSkKZGF0YSgiVVNhaXJwb3J0cyIpCiMgdmVyIGRldGFsbGVzCiMgP1VTYWlycG9ydHMKYGBgCgpOb3RhIHF1ZSBjYWRhIGFyaXN0YSBjb3JyZXNwb25kZSBhIHVuYSBhZXJvbMOtbmVhIChjYXJyaWVyKSB5IHRpcG8gZGUgYXZpw7NuIChBaXJjcmFmdCksIHkgbG9zIG5vZG9zIHNvbiBsb3MgYWVyb3B1ZXJ0b3MuIExvcyBkYXRvcyBkZSBsYXMgYXJpc3RhcyBjb3JyZXNwb25kZW4gYSB2dWVsb3MgZGUgRGljaWVtYnJlIGRlIDIwMTAsIHkgZXMgdW5hIGdyw6FmaWNhIGRpcmlnaWRhLgoKKipTb2JyZSBsb3MgZGF0b3M6KioKCnxWZXJ0ZXggYXR0cmlidXRlcyB8RGVzY3JpcHRpb258CnwtfC18CnxuYW1lfFN5bWJvbGljIHZlcnRleCBuYW1lLCB0aGlzIGlzIHRoZSB0aHJlZSBsZXR0ZXIgSUFUQSBhaXJwb3J0IGNvZGUufAp8Q2l0eXxDaXR5IGFuZCBzdGF0ZSwgd2hlcmUgdGhlIGFpcnBvcnQgaXMgbG9jYXRlZC58CnxQb3NpdGlvbnxQb3NpdGlvbiBvZiB0aGUgYWlycG9ydCwgaW4gV0dTIGNvb3JkaW5hdGVzLnwKCnxFZGdlIGF0dHJpYnV0ZXN8RGVzY3JpcHRpb258CnwtfC18CkNhcnJpZXJ8TmFtZSBvZiB0aGUgYWlybGluZS4gVGhlIG5ldHdvcmsgaW5jbHVkZXMgYm90aCBkb21lc3RpYyBhbmQgaW50ZXJuYXRpb25hbCBjYXJyaWVycyB0aGF0IHBlcmZvcm1lZCBhdCBsZWFzdCBvbmUgZmxpZ2h0IGluIERlY2VtYmVyIG9mIDIwMTAufAp8RGVwYXJ0dXJlcyB8VGhlIG51bWJlciBvZiBkZXBhcnR1cmVzIChmb3IgYSBnaXZlbiBhaXJsaW5lIGFuZCBhaXJjcmFmdCB0eXBlLnwKfFNlYXRzfCBUaGUgdG90YWwgbnVtYmVyIG9mIHNlYXRzIGF2YWlsYWJsZSBvbiB0aGUgZmxpZ2h0cyBjYXJyaWVkIG91dCBieSBhIGdpdmVuIGFpcmxpbmUsIHVzaW5nIGEgZ2l2ZW4gYWlyY3JhZnQgdHlwZS58CnxQYXNzZW5nZXJzfFRoZSB0b3RhbCBudW1iZXIgb2YgcGFzc2FuZ2VycyBvbiB0aGUgZmxpZ2h0cyBjYXJyaWVkIG91dCBieSBhIGdpdmVuIGFpcmxpbmUsIHVzaW5nIGEgZ2l2ZW4gYWlyY3JhZnQgdHlwZS58CnxBaXJjcmFmdCB8VHlwZSBvZiB0aGUgYWlyY3JhZnQuCnxEaXN0YW5jZSB8VGhlIGRpc3RhbmNlIGJldHdlZW4gdGhlIHR3byBhaXJwb3J0cywgaW4gbWlsZXMufAoKCgpgYGB7cn0KYWlycG9ydHMgPC0gVVNhaXJwb3J0cyAlPiUgYXNfdGJsX2dyYXBoKCkKYWlycG9ydHMKYGBgCgoKRW4gdG90YWwgc29uIGA3NTVgIGFlcm9wdWVydG9zIHkgYDIzLDQ3M2AgdGlwb3MgYWVyb2zDrW5lYXMgeSB0aXBvcyBkZSBhdmlvbmVzLgoKRXN0YSBnxZVhZmljYSBlcyB1biAqKm11bHRpZ3JhZm8qKiAocHVlZGUgaGFiZXIgdmFyaWFzIGFyaXN0YXMgY29uIGxhIG1pc21hIGRpcmVjY2nDs24gZW4gdW4gcGFyIGRlIG5vZG9zKS4KCk5vcyBpbnRlcmVzYSBlbiBwcmltZXIgbHVnYXIgYWdyZWdhciBhIHVuIGdyYWZvLCB5IGNvbnNpZGVyYXIgZWwgdG90YWwgZGUgcGFzYWplcm9zICAocHVlZGVzIHRhbWJpw6luIGNvbnNpZGVyYXIgbsO6bWVybyBkZSBhc2llbnRvcywgcG9yIGVqZW1wbG8pIHF1ZSB2aWFqw7MgZW50cmUgY2FkYSBwYXIgZGUgYWVyb3B1ZXJ0b3MuIFBvZGVtb3MgYWdyZWdhciBkZSBsYXMgc2lndWllbnRlIGZvcm1hOgoKYGBge3J9CiMgc2VsZWNjaW9uYW1vcyBzb2xvIHBhc2FqZXJvcwp2ZXJ0aWNlcyA8LSBhaXJwb3J0cyAlPiUgCiAgYWN0aXZhdGUoZWRnZXMpICU+JSAKICBzZWxlY3QodG8sIGZyb20sIFBhc3NlbmdlcnMpICU+JSBhc190aWJibGUoKQojIGFncmVnYXIKdmVydGljZXNfYWdyZWdhZG9zIDwtIHZlcnRpY2VzICU+JSAKICBncm91cF9ieSh0bywgZnJvbSkgJT4lIAogIHN1bW1hcmlzZShwYXggPSBzdW0oUGFzc2VuZ2VycykpCiMgbm9kb3MsIHkgYWdyZWdhciBlc3RhZG8Kbm9kb3MgPC0gYWlycG9ydHMgJT4lIGFjdGl2YXRlKG5vZGVzKSAlPiUgCiAgYXNfdGliYmxlKCkgJT4lIAogIHNlcGFyYXRlKENpdHksIGludG8gPSBjKCdjaXVkYWRfbm9tYnJlJywgJ2VzdGFkbycpLCBzZXAgPSAnLCAnKQojIGNvbnN0cnVpciBudWV2YSByZWQKYWVyb3B1ZXJ0b3MgPC0gdGJsX2dyYXBoKG5vZGVzID0gbm9kb3MsIGVkZ2VzID0gdmVydGljZXNfYWdyZWdhZG9zKSAKYWVyb3B1ZXJ0b3MgCmBgYAoKCmBgYHtyfQojIHNlbGVjY2lvbmFtb3Mgc29sbyBhc2llbnRvcwp2ZXJ0aWNlcyA8LSBhaXJwb3J0cyAlPiUgCiAgYWN0aXZhdGUoZWRnZXMpICU+JSAKICBzZWxlY3QodG8sIGZyb20sIFNlYXRzKSAlPiUgYXNfdGliYmxlKCkKIyBhZ3JlZ2FyCnZlcnRpY2VzX2FncmVnYWRvcyA8LSB2ZXJ0aWNlcyAlPiUgCiAgZ3JvdXBfYnkodG8sIGZyb20pICU+JSAKICBzdW1tYXJpc2UocGF4ID0gc3VtKFNlYXRzKSkKIyBub2RvcywgeSBhZ3JlZ2FyIGVzdGFkbwpub2RvcyA8LSBhaXJwb3J0cyAlPiUgYWN0aXZhdGUobm9kZXMpICU+JSAKICBhc190aWJibGUoKSAlPiUgCiAgc2VwYXJhdGUoQ2l0eSwgaW50byA9IGMoJ2NpdWRhZF9ub21icmUnLCAnZXN0YWRvJyksIHNlcCA9ICcsICcpCiMgY29uc3RydWlyIG51ZXZhIHJlZAphZXJvcHVlcnRvcyA8LSB0YmxfZ3JhcGgobm9kZXMgPSBub2RvcywgZWRnZXMgPSB2ZXJ0aWNlc19hZ3JlZ2Fkb3MpIAphZXJvcHVlcnRvcyAKYGBgCgoKIyMgRmlsdHJvIGRlIGNvbmV4aW9uZXMgZMOpYmlsZXMKClBvZGVtb3MgdGFtYmnDqW4gZmlsdHJhciBvcGNpb25hbG1lbnRlIGFxdWVsbGFzIGNvbmV4aW9uZXMgcXVlIHRlbmdhbiB1biBuw7ptZXJvIGRlIHBhc2FqZXJvcyBiYWpvIGR1cmFudGUgZWwgbWVzIGRlIG9ic2VydmFjacOzbi4gTGEgZGlzdHJpYnVjacOzbiBkZSBwYXNhamVyb3MgcG9kZW1vcyBleGFtaW5hcmxhIGNvbjoKCmBgYHtyfQpwYXNhamVyb3MgPC0gYWVyb3B1ZXJ0b3MgJT4lIGFjdGl2YXRlKGVkZ2VzKSAlPiUgCiAgc2VsZWN0KGZyb20sIHRvICwgcGF4KQpxdWFudGlsZShwdWxsKHBhc2FqZXJvcywgcGF4KSwgc2VxKDAsIDEsIDAuMSkpCmBgYAoKYGBge3J9CmNvcnRlX3BheCA8LSAxMDAKYWVyb19ncmFuZGVzIDwtIGFlcm9wdWVydG9zICU+JSBhY3RpdmF0ZShlZGdlcykgJT4lIAogIGZpbHRlcihwYXggPiBjb3J0ZV9wYXgpICU+JSAKICBhY3RpdmF0ZShub2RlcykgJT4lIAogIGZpbHRlcighbm9kZV9pc19pc29sYXRlZCgpKSAjZWxpbWluYXIgbm9kb3MgcXVlIHF1ZWRhbiBzaW4gY29uZXhpb25lcwpgYGAKCgpIYXogdW5hIHByaW1lcmEgZ3LDoWZpY2EgKGNoZWNhIHRhbWJpw6luIGNvbW8gY29sb3JlYXIgc2Vnw7puIHVuYSB2YXJpYWJsZSBkZSBub2Rvcyk6CgpgYGB7ciwgZmlnLndpZHRoID0gMTIsIGZpZy5oZWlnaHQ9MTB9CmFlcm9fZ3JhbmRlcyAlPiUgCiAgICBhY3RpdmF0ZShub2RlcykgJT4lIAogICAgbXV0YXRlKGNvbG9yX2NhID0gaWZlbHNlKGVzdGFkbyA9PSAiQ0EiLCAiQ0EiLCAiT3Ryb3MiKSkgJT4lIAogICAgZ2dyYXBoKGxheW91dCA9ICdmcicsIG5pdGVyID0gMjAwMCkgKyAKICAgIGdlb21fZWRnZV9saW5rKGFycm93ID0gYXJyb3cobGVuZ3RoID0gdW5pdCgyLCAnbW0nKSksIGFscGhhID0gMC4xLCBjb2xvdXI9ImdyYXkiKSArIAogICAgZ2VvbV9ub2RlX3BvaW50KGFlcyhjb2xvdXIgPSBjb2xvcl9jYSkpICsKICAgIHRoZW1lX2dyYXBoKCkKYGBgCgoKKipQcmVndW50YSAxKio6IGN1w6FudGFzIGNvbXBvbmVudGVzIHRpZW5lIGVzdGEgZ3LDoWZpY2EgKHRpcDogaGF6IHVuIG11dGF0ZSBjb24gbGEgZnVuY2nDs24gCipncm91cF9jb21wb25lbnRzKikKCkVzdGEgZ3LDoWZpY2EgY3VlbnRhIGNvbiBgOCBjb21wb25lbnRlc2AuIAoKYGBge3J9CmFlcm9fZ3JhbmRlcyAlPiUKICBhY3RpdmF0ZShub2RlcykgJT4lCiAgbXV0YXRlKGdyb3VwID0gZ3JvdXBfY29tcG9uZW50cygpKQpgYGAKCgpgYGB7cn0KYWVyb19ncmFuZGVzCmBgYAoKCipSZXR1cm4gdmFsdWUgb2YgZ3JvdXBfY29tcG9uZW50OiogYSBudW1lcmljIHZlY3RvciB3aXRoIHRoZSBtZW1iZXJzaGlwIGZvciBlYWNoIG5vZGUgaW4gdGhlIGdyYXBoLiBUaGUgZW51bWVyYXRpb24gaGFwcGVucyBpbiBvcmRlciBiYXNlZCBvbiBncm91cCBzaXplIHByb2dyZXNzaW5nIGZyb20gdGhlIGxhcmdlc3QgdG8gdGhlIHNtYWxsZXN0IGdyb3VwIAoKCioqUHJlZ3VudGEgMioqOiBwcnVlYmEgb3RybyBsYXlvdXQ6IGtrIG8gZ3JhcGhvcHQsIHBvciBlamVtcGxvLiDCv1B1ZWRlcyByZWNvbm9jZXIgZXN0cnVjdHVyYXMgZGlzdGludGFzPyDCv1F1w6kgbcOpdG9kbyBwYXJlY2UgZnVuY2lvbmFyIG1lam9yPwoKYGBge3IsIGZpZy53aWR0aCA9IDEyLCBmaWcuaGVpZ2h0PTEwfQphZXJvX2dyYW5kZXMgJT4lIAogICAgYWN0aXZhdGUobm9kZXMpICU+JSAKICAgICNtdXRhdGUoY29sb3JfY2EgPSBpZmVsc2UoZXN0YWRvID09ICJMQSIsICJMQSIsICJPdHJvcyIpKSAlPiUgCiAgICBnZ3JhcGgobGF5b3V0ID0gJ2trJykgKyAKICAgIGdlb21fZWRnZV9saW5rKGFycm93ID0gYXJyb3cobGVuZ3RoID0gdW5pdCgyLCAnbW0nKSksIGFscGhhID0gMC4xLCBjb2xvdXI9ImdyYXkiKSArIAogICAgZ2VvbV9ub2RlX3BvaW50KGFlcyhjb2xvdXIgPWVzdGFkbykpICsKICAgIHRoZW1lX2dyYXBoKCkKYGBgCgoKYGBge3IsIGZpZy53aWR0aCA9IDEyLCBmaWcuaGVpZ2h0PTEwfQphZXJvX2dyYW5kZXMgJT4lIAogICAgYWN0aXZhdGUobm9kZXMpICU+JSAKICAgIG11dGF0ZShjb2xvcl9jYSA9IGlmZWxzZShlc3RhZG8gPT0gIkNBIiwgIkNBIiwgIk90cm9zIikpICU+JSAKICAgIGdncmFwaChsYXlvdXQgPSAnZ3JhcGhvcHQnKSArIAogICAgZ2VvbV9lZGdlX2xpbmsoYXJyb3cgPSBhcnJvdyhsZW5ndGggPSB1bml0KDIsICdtbScpKSwgYWxwaGEgPSAwLjEsIGNvbG91cj0iZ3JheSIpICsgCiAgICBnZW9tX25vZGVfcG9pbnQoYWVzKGNvbG91ciA9IGNvbG9yX2NhKSkgKwogICAgdGhlbWVfZ3JhcGgoKQpgYGAKCiMjIyBFeHRyYWVyIGNvbXBvbmVudGUgZ3JhbmRlCgpGaWx0cmEgbGEgY29tcG9uZW50ZSBjb25leGEgbcOhcyBncmFuZGU6CgpgYGB7ciwgZmlnLndpZHRoID0gMTIsIGZpZy5oZWlnaHQ9MTB9CmFlcm8gPC0gYWVyb19ncmFuZGVzICU+JSAKICAgIGFjdGl2YXRlKG5vZGVzKSAlPiUgCiAgICBtdXRhdGUoY29tcG9uZW50ID0gZ3JvdXBfY29tcG9uZW50cygpKSAlPiUKICAgIGZpbHRlcihjb21wb25lbnQgPT0gMSkKYGBgCgoKIyMjIEludGVybWVkaWFjacOzbgoKQ2FsY3VsYSBpbnRlcm1lZGlhY2nDs246CgpgYGB7cn0KYWVybyA8LSBhZXJvICU+JSBhY3RpdmF0ZShub2RlcykgJT4lIAogIG11dGF0ZShpbnRlcm1lZGlhY2lvbiA9IGNlbnRyYWxpdHlfYmV0d2Vlbm5lc3MoKSkKYWVybwpgYGAKCgoqKlByZWd1bnRhIDMqKjogwr9jdcOhbGVzIHNvbiBsb3MgYWVyb3B1ZXJ0b3MgY29uIGludGVybWVkaWFjacOzbiBtw6FzIGdyYW5kZT8gCihjb252aWVydGUgZWwgb2JqZXRvIGRlIGxhIGdyw6FmaWNhIGEgdGliYmxlIGRlc3B1w6lzIGRlIGFjdGl2YXIgbm9kb3MpLgoKYGBge3J9CmFlcm8gJT4lIGFjdGl2YXRlKG5vZGVzKSAlPiUgCiAgbXV0YXRlKGludGVybWVkaWFjaW9uID0gY2VudHJhbGl0eV9iZXR3ZWVubmVzcygpKSAlPiUKICBhc190aWJibGUoKSAlPiUKICBhcnJhbmdlKGRlc2MoaW50ZXJtZWRpYWNpb24pKSU+JQogIGhlYWQoKQpgYGAKfENpdWRhZHwgRXN0YWRvfCBJbnRlcm1lZGlhY2nDs258CnwtfC18LXwKfEFuY2hvcmFnZSAgICB8IEFLLUFsYXNrYSAgfCAgICAgICA4NjY4NnwKfERlbnZlciAgfCAgICAgIENPLUNvbG9yYWRvfDM1NDQ0fAp8TWlubmVhcG9saXMgfCAgTU4tIE1pbm5lc290YXwgICAzMzY3NHwKfEJldGhlbHwgICAgICAgQUstQWxhc2thfDMxNDEyfAp8U2VhdHRsZSB8ICAgICAgV0EtV2FzaGluZ3RvbiB8MzAyODZ8CgpBaG9yYSBoYXogdW5hIGdyw6FmaWNhIGNvbG9yZWFuZG8gY29uIHVuIGVzdGFkbyByZWxldmFudGUgKGNvbnNpZGVyYSB0dSByZXNwdWVzdGEgZGUgbGEgcHJlZ3VudGEgYW50ZXJpb3IpIHkgdXNhbmRvIGxhIGludGVybWVkaWFjacOzbiBjb21vIHRhbWHDsW86CgpgYGB7ciwgZmlnLndpZHRoID0gMTIsIGZpZy5oZWlnaHQ9MTB9CmFlcm8gJT4lCiAgICBhY3RpdmF0ZShub2RlcykgJT4lIAogICAgbXV0YXRlKGNvbG9yX2VkbyA9IGlmZWxzZShlc3RhZG8gPT0gIkFLIiwgIkFLIiwgIk90cm9zIikpICU+JSAKICAgIGdncmFwaChsYXlvdXQgPSAnZnInLCBuaXRlcj0yMDAwKSArIAogICAgZ2VvbV9lZGdlX2xpbmsoYXJyb3cgPSBhcnJvdyhsZW5ndGggPSB1bml0KDIsICdtbScpKSwgYWxwaGEgPSAwLjEsIGNvbG91cj0iZ3JheSIpICsgCiAgICBnZW9tX25vZGVfcG9pbnQoYWVzKHNpemUgPSBpbnRlcm1lZGlhY2lvbiwgY29sb3VyPWNvbG9yX2VkbykpICsKICAgIHRoZW1lX2dyYXBoKCkKYGBgCgoKKipQcmVndW50YSA0KiogRXhwbGljYSBlbCBub2RvIGNvbiBtYXlvciBpbnRlcm1lZGlhY2nDs24gZGUgbGEgZ3LDoWZpY2EuIMK/UXXDqSBjb25lY3RhPwoKQ29uZWN0YSBBbGFza2EgY29uIGVsIHJlc3RvIGRlIGxvcyBFc3RhZG9zLgoKIyMjIENlbnRyYWxpZGFkIGRlIGVpZ2VudmVjdG9yCgpDYWxjdWxhIGNlbnRyYWxpZGFkIGRlIGVpZ2VudmVjdG9yLCB5IGFob3JhIHVzYSB0YW1hw7FvIHBhcmEgZXN0YSBjZW50cmFsaWRhZCB5IApjb2xvciBwYXJhIGludGVybWVkaWFjacOzbgoKYGBge3J9CmFlcm88LSBhZXJvICU+JQogICAgYWN0aXZhdGUobm9kZXMpICU+JSAKICAgIG11dGF0ZShjZW50cmFsX2VpZ2VuID0gY2VudHJhbGl0eV9laWdlbigpKQpgYGAKCgpgYGB7cn0KYWVybyAlPiUKICAgIGFjdGl2YXRlKG5vZGVzKSAlPiUgCiAgICBtdXRhdGUoY2VudHJhbF9laWdlbiA9IGNlbnRyYWxpdHlfZWlnZW4oKSkgJT4lCiAgICBhc190aWJibGUoKSAlPiUKICAgIGFycmFuZ2UoZGVzYyhjZW50cmFsX2VpZ2VuKSklPiUKICAgIGhlYWQoKQpgYGAKCioqUHJlZ3VudGEgNSoqIMK/Q3XDoWxlcyBzb24gbG9zIGFlcm9wdWVydG9zIGNvbiBtYXlvciBjZW50cmFsaWRhZCBkZSBlaWdlbnZlY3Rvcj8KQ29udHJhc3RhIGNvbiBpbnRlcm1lZGlhY2nDs24uCgpjaXVkYWRfbm9tYnJlfGVzdGFkb3xpbnRlcm1lZGlhY2lvbnxjZW50cmFsX2VpZ2VufAp8LXwtfC18IC18CnxBdGxhbnRhfAlHQS1HZW9yZ2lhfAkyNjI5MC4wOQl8MS4wMDAwMDAwfAp8Q2hpY2Fnb3wJSUwtSWxsaW5vaXN8CTI5MzYxLjQ3CXwwLjk4NDAwMzB8CnxEYWxsYXMvRnQuV29ydGh8CVRYLVRleGFzfDIwNzQzLjU1CXwwLjkyMzAwNzV8CnxEZW52ZXJ8CUNPLUNvbG9yYWRvfDM1NDQ0LjQzCXwwLjkxMzEzMjN8CnxNaW5uZWFwb2xpc3wJTU4tTWlubmVzb3RhfDMzNjczLjc2fAkwLjkwODIzMzZ8CnxEZXRyb2l0fAlNSS1NaWNoaWdhbnwxNzE4MS43MHwwLjg5ODc2ODB8CgojIyMgRXhhbWluYXIgY2VudHJhbGlkYWQKCkVsaW1pbmEgbG9zIGFlcm9wdWVydG9zIGRlIEFsYXNrYSB5IHZ1ZWx2ZSBhIGdyYWZpY2FyLCBlc3RhIHZlegp1c2FuZG8gY2VudHJhbGlkYWQgZGUgZWlnZW52ZWN0b3IgcGFyYSBjb2xvciB5IHRhbWHDsW8uCgpgYGB7ciwgZmlnLndpZHRoID0gMTIsIGZpZy5oZWlnaHQ9MTB9CmFlcm8gJT4lCiAgYWN0aXZhdGUobm9kZXMpICU+JSAKICBmaWx0ZXIoZXN0YWRvIT0iQUsiKSAlPiUgCmdncmFwaChsYXlvdXQgPSAnZ3JhcGhvcHQnLCBzcHJpbmcuY29uc3RhbnQgPSAwLjI1LCBjaGFyZ2UgPSAwLjA1LCBuaXRlciA9IDMwMCkgKyAKICBnZW9tX2VkZ2VfbGluazIoYXJyb3cgPSBhcnJvdyhsZW5ndGggPSB1bml0KDIsICdtbScpKSwgYWxwaGEgPSAwLjAxLCBjb2xvdXI9ImJsYWNrIikgKyAKICBnZW9tX25vZGVfcG9pbnQoYWVzKHNpemUgPSBjZW50cmFsX2VpZ2VuLCBjb2xvdXI9Y2VudHJhbF9laWdlbikpICsKICB0aGVtZV9ncmFwaCgpIApgYGAKCioqUHJlZ3VudGEgNioqOiDCv2NhbGN1bGFyIGNlbnRyYWxpZGFkIHkgbHVlZ28gZmlsdHJhciBub2RvcyBlcyBsbyBtaXNtbyBxdWUgZmlsdHJhciBub2RvcyB5IGx1ZWdvIGNhbGN1bGFyIGNlbnRyYWxpZGFkPwoKTm8uIEZhbHRhIGRlc2Fycm9sbGFyIHBvciBxdcOpLgoKKipQcmVndW50YSA3Kio6IGV4cGVyaW1lbnRhIGNvbiBsb3MgcGFyw6FtZXRyb3MgZGVsIGxheW91dCAocG9yIGVqZW1wbG8sIGxvcyAyIHF1ZSBzZSB1c2FuIGFycmliYSkuIMK/Q8OzbW8gb2J0aWVuZXMgbWVqb3JlcyByZXN1bHRhZG9zPwoKYGBge3IsIGZpZy53aWR0aCA9IDEyLCBmaWcuaGVpZ2h0PTEwfQphZXJvICU+JQogIGFjdGl2YXRlKG5vZGVzKSAlPiUgCiAgZmlsdGVyKGVzdGFkbyE9IkFLIikgJT4lIApnZ3JhcGgobGF5b3V0ID0gJ2dyYXBob3B0Jywgc3ByaW5nLmNvbnN0YW50ID0gMC45NSwgY2hhcmdlID0gMC4wNSwgbml0ZXIgPSAzMDApICsgCiAgZ2VvbV9lZGdlX2xpbmsyKGFycm93ID0gYXJyb3cobGVuZ3RoID0gdW5pdCgyLCAnbW0nKSksIGFscGhhID0gMC4wMSwgY29sb3VyPSJibGFjayIpICsgCiAgZ2VvbV9ub2RlX3BvaW50KGFlcyhzaXplID0gY2VudHJhbF9laWdlbiwgY29sb3VyPWNlbnRyYWxfZWlnZW4pKSArCiAgdGhlbWVfZ3JhcGgoKSAKYGBgCgoKYGBge3IsIGZpZy53aWR0aCA9IDEyLCBmaWcuaGVpZ2h0PTEwfQphZXJvICU+JQogIGFjdGl2YXRlKG5vZGVzKSAlPiUgCiAgZmlsdGVyKGVzdGFkbyE9IkFLIikgJT4lIApnZ3JhcGgobGF5b3V0ID0gJ2dyYXBob3B0Jywgc3ByaW5nLmNvbnN0YW50ID0gMC4yNSwgY2hhcmdlID0gMC45NSwgbml0ZXIgPSAzMDApICsgCiAgZ2VvbV9lZGdlX2xpbmsyKGFycm93ID0gYXJyb3cobGVuZ3RoID0gdW5pdCgyLCAnbW0nKSksIGFscGhhID0gMC4wMSwgY29sb3VyPSJibGFjayIpICsgCiAgZ2VvbV9ub2RlX3BvaW50KGFlcyhzaXplID0gY2VudHJhbF9laWdlbiwgY29sb3VyPWNlbnRyYWxfZWlnZW4pKSArCiAgdGhlbWVfZ3JhcGgoKSAKYGBgCgoKCmBgYHtyLCBmaWcud2lkdGggPSAxMiwgZmlnLmhlaWdodD0xMH0KYWVybyAlPiUKICBhY3RpdmF0ZShub2RlcykgJT4lIAogIGZpbHRlcihlc3RhZG8hPSJBSyIpICU+JSAKZ2dyYXBoKGxheW91dCA9ICdncmFwaG9wdCcsIHNwcmluZy5jb25zdGFudCA9IDAuNSwgY2hhcmdlID0gMC41LCBuaXRlciA9IDMwMCkgKyAKICBnZW9tX2VkZ2VfbGluazIoYXJyb3cgPSBhcnJvdyhsZW5ndGggPSB1bml0KDIsICdtbScpKSwgYWxwaGEgPSAwLjAxLCBjb2xvdXI9ImJsYWNrIikgKyAKICBnZW9tX25vZGVfcG9pbnQoYWVzKHNpemUgPSBjZW50cmFsX2VpZ2VuLCBjb2xvdXI9Y2VudHJhbF9laWdlbikpICsKICB0aGVtZV9ncmFwaCgpIApgYGAKCioqUHJlZ3VudGEgOCoqIChtw6FzIGRpZsOtY2lsKTogZXRpcXVldGEgbG9zIG5vZG9zLiBFdGlxdWV0YSBzb2xvIGxvcyBub2RvcyBxdWUgdGVuZ2FuIGNlbnRyYWxpZGFkIGRlIGVpZ2VudmVjdG9yIGFsdGEuIFB1ZWRlcyBleHBlcmltZW50YXIgKGxheW91dCwgY29sb3JlcywgdGFtYcOxbyBkZSB0ZXh0bykKY29uIGVzdGUgY8OzZGlnbzoKCmBgYHtyLCBmaWcud2lkdGggPSAxMiwgZmlnLmhlaWdodD0xMH0KYWVybyAlPiUKICBhY3RpdmF0ZShub2RlcykgJT4lIAogIGZpbHRlcihlc3RhZG8hPSJBSyIpICU+JSAKZ2dyYXBoKGxheW91dCA9ICdncmFwaG9wdCcsIHNwcmluZy5jb25zdGFudCA9IDAuMjUsIGNoYXJnZSA9IDAuMDUsIG5pdGVyID0gMzAwKSArIAogIGdlb21fZWRnZV9saW5rMihhcnJvdyA9IGFycm93KGxlbmd0aCA9IHVuaXQoMiwgJ21tJykpLCBhbHBoYSA9IDAuMDEsIGNvbG91cj0iYmxhY2siKSArIAogIGdlb21fbm9kZV9wb2ludChhZXMoc2l6ZSA9IGNlbnRyYWxfZWlnZW4sIGNvbG91cj1jZW50cmFsX2VpZ2VuKSkgKwogIGdlb21fbm9kZV90ZXh0KGFlcyhsYWJlbCA9IG5hbWUsIGFscGhhID0gY2VudHJhbF9laWdlbj4wLjg5ODc2NzkpLCByZXBlbCA9IFRSVUUsIHNpemUgPSAzLCBjb2xvciA9ICJibGFjayIpICsKICB0aGVtZV9ncmFwaCgpIApgYGAKCg==